home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Collection of Tools & Utilities
/
Collection of Tools and Utilities.iso
/
clipper
/
nfsrc21.zip
/
CLRSEL.PRG
< prev
next >
Wrap
Text File
|
1991-08-17
|
25KB
|
792 lines
/*
* File......: ClrSel.PRG
* Author....: Dave Adams
* CIS ID....: 72037,2654
* Date......: $Date: 17 Aug 1991 15:05:22 $
* Revision..: $Revision: 1.2 $
* Log file..: $Logfile: E:/nanfor/src/clrsel.prv $
*
* This is an original work by Dave Adams and is placed in the
* public domain.
*
* Modification history:
* ---------------------
*
* $Log: E:/nanfor/src/clrsel.prv $
*
* Rev 1.2 17 Aug 1991 15:05:22 GLENN
* Don Caton made corrected some spelling errors in the doc
*
* Rev 1.1 15 Aug 1991 23:03:50 GLENN
* Forest Belt proofread/edited/cleaned up doc
*
* Rev 1.0 13 Jun 1991 15:21:46 GLENN
* Initial revision.
*
*/
/* $DOC$
* $FUNCNAME$
* FT_ClrSel()
* $CATEGORY$
* Menus/Prompts
* $ONELINER$
* User Selectable Colour Routine
* $SYNTAX$
* FT_ClrSel( <aClrData>, [ <lClrMode> ], [ <cTestChr> ] -> aClrData
* $ARGUMENTS$
*
* <aClrData> is an array of subarrays, with each subarray containing
* information about the colour settings.
*
* The subarray has the following structure:
*
* [1] cName is the name of this colour setting i.e. "Pick List"
* Maximum length is 20 bytes
*
* [2] cClrStr is the current colour string
* Default is "W/N,N/W,N/N,N/N,N/W"
*
* If Setting type is "M" (Menu) the colours are...
* 1. Prompt Colour
* 2. Message Colour
* 3. HotKey Colour
* 4. LightBar Colour
* 5. LightBar HotKey Colour
*
* Note: While there are many ways to code the individual
* colour combinations, they should be in the same
* format that gets returned from SETCOLOR(), so
* the defaults can be found in the colour palette.
*
* foreground [+] / background [*]
* i.e. "GR+/BG*, N/W*, N+/N, , W/N"
*
* [3] cType is the type of colour setting
* Default is "W" (Window)
*
* T = Title Only 1 colour element
* D = Desktop Background colour and character
* M = Menu For FT_Menuto() style menus
* W = Window Windows with radio buttons
* G = Get For use with @ SAY...
* B = Browse For tBrowse() and *dbEdit()
* A = aChoice Pick-lists etc...
*
* W/G/B/A are functionally the same but will provide
* a more appropriate test display.
*
* [4] cFillChar is the character (for desktop background only)
* Default is CHR(177) "▒▒▒▒▒▒▒▒▒▒▒▒▒▒"
*
*
* <lClrMode> .T. use colour palette
* .F. use monochrome palette
*
* Default is the ISCOLOR() setting
*
* <cTestChr> 2 Byte character string for colour test display
*
* Default is the CHR(254)+CHR(254) "■■"
*
* $RETURNS$
* An array identical to the one passed, with new selected colours
* $DESCRIPTION$
* This function allows users to select their own colour combinations
* for all the different types of screen I/O in a typical application.
* This facilitates an easy implementation of Ted Means' replacement
* of the @..PROMPT/MENU TO found in the NanForum Toolkit. If you are
* not using FT_MENUTO(), you can specify "A" for setting type and have
* a normal colour string returned.
* $EXAMPLES$
* LOCAL aClrs := {}
* LOCAL lColour := ISCOLOR()
* LOCAL cChr := CHR(254) + CHR(254)
*
* SET SCOREBOARD Off
* SETBLINK( .F. ) // Allow bright backgrounds
*
* *.... a typical application might have the following different settings
* * normally these would be stored in a .dbf/.dbv
* aClrs := {;
* { "Desktop", "N/BG", "D", "▒" }, ;
* { "Title", "N/W", "T" }, ;
* { "Top Menu", "N/BG,N/W,W+/BG,W+/N,GR+/N", "M" }, ;
* { "Sub Menu", "W+/N*,GR+/N*,GR+/N*,W+/R,G+/R","M" }, ;
* { "Standard Gets", "W/B, W+/N,,, W/N", "G" }, ;
* { "Nested Gets", "N/BG, W+/N,,, W/N", "G" }, ;
* { "Help", "N/G, W+/N,,, W/N", "W" }, ;
* { "Error Messages", "W+/R*,N/GR*,,,N/R*", "W" }, ;
* { "Database Query", "N/BG, N/GR*,,,N+/BG", "B" }, ;
* { "Pick List", "N/GR*,W+/B,,, BG/GR*", "A" } ;
* }
*
* aClrs := FT_ClrSel( aClrs, lColour, cChr )
* $END$
*/
/*
* File Contents
*
* FT_ClrSel( aClrs, lColour, cChr ) user selectable colour routine
* _ftHiLite( nRow, nCol, cStr, nLen ) re-hilite an achoice prompt
* _ftColours( aOpt, aClrPal, lColour ) control colour selection
* _ftShowIt( aOpt ) show a sample of the colours
* _ftClrSel( aClrPal, cClr, nElem, aOpt) pick a colour
* _ftClrPut( cClrStr, nElem, cClr ) place a clr element into str
* _ftDeskChar( aOpt ) select desktop char
* _ftChr2Arr( cString, cDelim ) parse string into array
* _ftArr2Chr( aArray, cDelim ) create string from array
* _ftShowPal( aClrPal, cChr ) paint palette on screen
* _ftInitPal( aClrTab ) create the palette
* _ftIdentArr( aArray1, aArray2 ) compare array contents
*
*/
/*
* Commentary
*
* Thanks to Brian Loesgen for offering ideas and helping to tweak
* the code.
*
*
*/
*------------------------------------------------
// Pre-processor stuff
#include "box.ch"
#include "setcurs.ch"
#include "inkey.ch"
#define C_NAME 1
#define C_CLR 2
#define C_TYPE 3
#define C_CHAR 4
#translate Single( <t>, <l>, <b>, <r> ) =>;
@ <t>, <l>, <b>, <r> BOX B_SINGLE
#translate Double( <t>, <l>, <b>, <r> ) =>;
@ <t>, <l>, <b>, <r> BOX B_DOUBLE
#translate ClearS( <t>, <l>, <b>, <r> ) =>;
@ <t>, <l> CLEAR TO <b>, <r>
#translate BkGrnd( <t>, <l>, <b>, <r>, <c> ) =>;
DispBox( <t>, <l>, <b>, <r>, REPLICATE(<c>,9) )
#command DEFAULT <p> TO <val> [, <pn> TO <valn> ] =>;
<p> := IIF( <p> == Nil, <val>, <p> ); ;
[ <pn> := IIF( <pn> == Nil, <valn>, <pn> ) ]
*------------------------------------------------
// Demo of FT_ClrSel()
/*
* To run the sample program:
*
* Compile : Clipper ClrSel /n /m /w /dFT_TEST
* Link : Rtlink FILE ClrSel LIB NanFor [/PLL:Fullbase]
* .OR. [/PLL:Base50]
*
* ClrSel MONO To force monochrome mode
* ClrSel NOSNOW To prevent CGA snowstorms
* ClrSel EGA 43 line mode
* ClrSel VGA 50 line mode
*
*/
#IFDEF FT_TEST
FUNCTION Main( cVidMode )
LOCAL nRowDos := ROW()
LOCAL nColDos := COL()
LOCAL lBlink := SETBLINK( .F. ) // make sure it starts out .F.
LOCAL aEnvDos := FT_SaveSets()
LOCAL cScrDos := SAVESCREEN( 00, 00, MAXROW(), MAXCOL() )
LOCAL lColour := .F.
LOCAL aClrs := {}
DEFAULT cVidMode TO ""
NOSNOW( ( "NOSNOW" $ UPPER( cVidMode ) ) )
IF "VGA" $ UPPER( cVidMode )
SETMODE( 50, 80 )
ENDIF
IF "EGA" $ UPPER( cVidMode )
SETMODE( 43, 80 )
ENDIF
lColour := IF( "MONO" $ UPPER( cVidMode ), .F., ISCOLOR() )
SET SCOREBOARD Off
SETCURSOR( SC_NONE )
lBlink := SETBLINK( .F. )
*.... a typical application might have the following different settings
* normally these would be stored in a .dbf/.dbv
aClrs := {;
{ "Desktop", "N/BG", "D", "▒" }, ;
{ "Title", "N/W",